home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / h / frame.h < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  3.2 KB  |  139 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.  
  24.     frame.h
  25.  
  26.     frame stack and non-local jump
  27. */
  28.  
  29.  
  30. /*  IHS    Invocation History Stack  */
  31.  
  32. typedef struct invocation_history {
  33.     object    ihs_function;
  34.     object    *ihs_base;
  35. } *ihs_ptr;
  36.  
  37. #define    IHSSIZE        1024
  38. #define    IHSGETA        32
  39.  
  40. struct invocation_history ihs_stack[IHSSIZE + IHSGETA + IHSGETA];
  41.  
  42. ihs_ptr ihs_org;
  43.  
  44. ihs_ptr ihs_limit;
  45.  
  46. ihs_ptr ihs_top;
  47.  
  48. #define    ihs_check  \
  49.     if (ihs_top >= ihs_limit)  \
  50.         ihs_overflow()
  51.  
  52. #define ihs_push(function)  \
  53.     (++ihs_top)->ihs_function = (function);  \
  54.     ihs_top->ihs_base = vs_base
  55.  
  56. #define ihs_pop()     (ihs_top--)
  57.  
  58.  
  59. #define make_nil_block()  \
  60. {  \
  61.     object x;  \
  62.   \
  63.     lex_copy();  \
  64.     x = alloc_frame_id();  \
  65.     vs_push(x);  \
  66.     lex_block_bind(Cnil, x);  \
  67.     vs_pop;  \
  68.     frs_push(FRS_CATCH, x);  \
  69. }
  70.  
  71.  
  72. /*  Frame Stack  */
  73.  
  74. enum fr_class {
  75.     FRS_CATCH,            /* for catch,block,tabbody */
  76.     FRS_CATCHALL,                   /* for catchall */
  77.     FRS_PROTECT                    /* for protect-all */
  78. };
  79.  
  80. struct frame {
  81.     jmp_buf        frs_jmpbuf;
  82.     object        *frs_lex;
  83.     bds_ptr        frs_bds_top;
  84.     enum fr_class    frs_class;
  85.     object        frs_val;
  86.     ihs_ptr        frs_ihs;
  87. };
  88.  
  89. typedef struct frame *frame_ptr;
  90.  
  91. #define    alloc_frame_id()    alloc_object(t_spice)
  92.  
  93. /*
  94. frs_class |            frs_value                 |  frs_prev
  95. ----------+--------------------------------------+--------------
  96. CATCH     | frame-id, i.e.                       |
  97.       |    throw-tag,                        |
  98.       |    block-id (uninterned symbol), or  | value of ihs_top
  99.       |    tagbody-id (uninterned symbol)    | when the frame
  100. ----------+--------------------------------------| was pushed
  101. CATCHALL  |               NIL                    |
  102. ----------+--------------------------------------|
  103. PROTECT   |               NIL                    |
  104. ----------------------------------------------------------------
  105. */
  106.  
  107. #define FRSSIZE        1024
  108. #define    FRSGETA        16
  109.  
  110. struct frame frame_stack[FRSSIZE + FRSGETA + FRSGETA];
  111.  
  112. frame_ptr frs_org;
  113.  
  114. frame_ptr frs_limit;
  115.  
  116. frame_ptr frs_top;        /* frame stack top */
  117.  
  118. #define frs_push(class, val)  \
  119.     if (++frs_top >= frs_limit)  \
  120.         frs_overflow();  \
  121.     frs_top->frs_lex = lex_env;\
  122.     frs_top->frs_bds_top = bds_top;  \
  123.     frs_top->frs_class = (class);  \
  124.     frs_top->frs_val = (val);  \
  125.     frs_top->frs_ihs = ihs_top;  \
  126.         setjmp(frs_top->frs_jmpbuf)
  127.  
  128. #define frs_pop()    frs_top--
  129.  
  130.  
  131. /*  global variables used during non-local jump  */
  132.  
  133. bool nlj_active;        /* true during non-local jump */
  134. frame_ptr nlj_fr;        /* frame to return  */
  135. object nlj_tag;            /* throw-tag, block-id, or */
  136.                 /* (tagbody-id . label).   */
  137.  
  138.  
  139.